package CommandLine;
use strict;
use warnings;
use Data::Dumper;
use Getopt::Long qw( :config gnu_getopt );
# user modules
use SimpleError;

# get_options
# 1. see if there is a "$cfg_option" setting available in
#    the options data structure,
#    if so, try to read the option's parameter from command line,
#    if the command line DOES specify a CONFIGURATION option,
#    read options from that configuration file into the options
#    data structure.
# 2. parse command line options and save them to the options data
#    structure, and possibly overwrite those set in step (1).
#    i.e., command line options have the highest priority.
sub get_options {
    my ($options, $cfg_option) = @_;
    if (defined $cfg_option && exists $options->{$cfg_option}) {
        try_config($options, $cfg_option);
    }
    return getopt_long_get_options($options);
}

# To try to read configuration from a text file
# 1. make a copy of the original options data structure
#    which will be fed to the GetOptions() library subroutine
#    to parse the command line for the 1st time
# 2. if the result shows that there is a CONFIGURATION option
#    provided, read the file's content to the original options
#    data structure
# 3. return the original data structure
sub try_config {
    my ($options, $cfg_option) = @_;
    my $my_options = deep_copy($options);
    getopt_long_get_options($my_options);
    if (defined $my_options->{$cfg_option}{'value'}) {
        read_config($my_options->{$cfg_option}{'value'}, $options);
    }
    return $options;
}

sub read_config {
    my ($file, $options) = @_;
    open CONFIG, '<', $file or error("$file: cannot open for read.");
    my $opt_count = 0;
    message("reading configuration from file: $file.");
    while (<CONFIG>) {
        chomp;
        s/^(?:^|\s)\#.*//; # remove comment
        next if /^\s*$/;
        #SimpleError::debug("config line: $_");
        my ($op, $val) = $_ =~ /^\s*(\S+)\s*[:=\s]\s*(\S*)/i;
        unless (defined $op) {
            warning("invalid configuration line: '$_':ignored");
            next;
        }
        unless (exists $options->{$op}) {
            warning("unknown option: '$op': skipped");
            next;
        }
        $opt_count++;
        if (ref $options->{$op}{'value'} eq 'ARRAY') {
            push @{ $options->{$op}{'value'} }, $val;
        } else {
            $options->{$op}{'value'} = $val;
        }
    }
    return $opt_count;
}

# To enable second time parsing of the command line arguments,
# firstly make the @ARGV array local
sub getopt_long_get_options {
    my ($options) = @_;
    #SimpleError::debug("\@ARGV=[@ARGV]");
    local @ARGV = @ARGV;
    error("error when processing options, quit.")
        unless Getopt::Long::GetOptions(
        map {;
            $options->{$_}{'option'} =>
                (ref $options->{$_}{'value'}) ? $options->{$_}{'value'} : \ $options->{$_}{'value'};
        } keys %$options
    );
    # store the rest arguments into an separate option
    $options->{'args'} = +{ 'option' => 'arguments', 'value' => [ @ARGV ], };
    return scalar @{ $options->{'args'}{'value'} };
}

sub deep_copy {
    my $data = shift;
    my $expr = Data::Dumper::->Dump([ $data ], [ qw($copy) ]);
    my $copy;
    eval $expr or error("cannot evaluate the dumped content:\n$expr\n");
    return $copy;
}

sub print_options {
    my ($options) = @_;
    my $opt_count = 0;
    for my $op (keys %$options) {
        my ($key, $value);
        if (ref $options->{$op} eq 'HASH') {
            my $type = ref $options->{$op}{'value'};
            $key = $options->{$op}{'option'};
            $value = '[' .
                ( $type eq 'ARRAY' ? join(',', @{ $options->{$op}{'value'} })
                    : defined $options->{$op}{'value'} ? $options->{$op}{'value'}
                    : '<undef>' ) . ']';
        } else {
            $key = $op;
            $value = ref $options->{$op} eq 'ARRAY' ? "[@{$options->{$op}}]" : "'$options->{$op}'";
        }
        printf STDERR "%-20s: %s\n", $key, $value;
        $opt_count++;
    }
    return $opt_count;
}

sub apply_defaults {
    my ($defaults, $options, $token) = @_;
    my $applied_count;
    for my $k (keys %$defaults) {
        unless ( exists $options->{$k} ) {
            warning("$k: no such option, skipped.");
            next;
        }
        my $option = $options->{$k};
        next unless defined $option->{'value'};
        # default will be applied only if the value is "$token", or the default item is 'force'
        next unless $option->{'value'} eq $token || $defaults->{$k}{force};
        my $reference = $defaults->{$k}{'reference'};
        my $def_value = $defaults->{$k}{'value'};
        my $ref_value;
        # if $reference is defined, then the 'value' it refers must also be defined
        # otherwise, a warning will be issued (treat it as an ERROR)
        if (defined $reference) {
            $ref_value = $options->{$reference}{'value'}; # warning if not existent!
            $ref_value =~ s/\.[^.]*$// if $defaults->{$k}{'base'};
        }
        # default value: a code ref or a simple scalar
        if (ref $def_value eq 'CODE') {
            $option->{value} = $def_value->($option->{'value'}, $ref_value, $options);
        } else {
            $def_value =~ s/\*/$ref_value/g if defined $ref_value;
            $option->{value} = $def_value;
        }
        $applied_count++;
    }
    return $applied_count;
}

sub apply_checks {
    my ($options) = @_;
    my $check_count = 0;
    for (keys %$options) {
        next unless exists $options->{$_}{'check'};
        my $checker = $options->{$_}{check};
        error("option: '$_': check failed") unless
            ( ref($checker) eq 'CODE' && $checker->($options, $_) )
            || ( $checker && defined $options->{$_}{value} );
        $check_count++;
    }
    return $check_count;
}

# delete duplicated entries in an array, which is passed
# in by array reference
sub delete_duplicate {
    my ($ar) = @_;
    my %tbl;
    my @unique;
    my $del_count = 0;
    for my $i (0 .. $#$ar) {
        if (exists $tbl{$ar->[$i]}) {
            $del_count++;
        } else {
            $tbl{$ar->[$i]} = 1;
            push @unique, $ar->[$i];
        }
    }
    @{$ar} = @unique;
    $del_count;
}

1;
